home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume3 / g-format / part3 < prev    next >
Encoding:
Internet Message Format  |  1986-11-30  |  40.6 KB
  1. From: J.D.Aplevich <genrad!decvax!watmath!watdcsu!aplevich>
  2. Subject: G-format compilers for Ultrix/Unix Vaxes (3 of 4)
  3. Newsgroups: mod.sources
  4. Approved: jpn@panda.UUCP
  5.  
  6. Mod.sources:  Volume 3, Issue 39
  7. Submitted by: J.D.Aplevich <decvax!watmath!watdcsu!aplevich>
  8.  
  9.  
  10. #!/bin/sh
  11. # This is a shell archive, meaning:
  12. # 1. Remove everything above the #!/bin/sh line.
  13. # 2. Save the resulting text in a file.
  14. # 3. Execute the file with /bin/sh (not csh) to create the files:
  15. #    gfloat
  16. # This archive created: Wed Oct 30 10:33:37 1985
  17. export PATH; PATH=/bin:$PATH
  18. if test ! -d 'gfloat'
  19. then
  20.     mkdir 'gfloat'
  21. fi
  22. cd 'gfloat'
  23. if test ! -d 'f77'
  24. then
  25.     mkdir 'f77'
  26. fi
  27. cd 'f77'
  28. if test ! -d 'src'
  29. then
  30.     mkdir 'src'
  31. fi
  32. cd 'src'
  33. if test ! -d 'f77pass1'
  34. then
  35.     mkdir 'f77pass1'
  36. fi
  37. cd 'f77pass1'
  38. if test -f 'bb.c.diff'
  39. then
  40.     echo shar: over-writing existing file "'bb.c.diff'"
  41. fi
  42. cat << \SHAR_EOF > 'bb.c.diff'
  43. *** ../f77/src/f77pass1/bb.c.orig    Tue Oct 29 15:15:44 1985
  44. --- ../f77/src/f77pass1/bb.c    Tue Oct 29 15:22:15 1985
  45. ***************
  46. *** 717,722
  47.                    }
  48.                 else  if( ISINT(type) )
  49.                      fprintf(diagfile," ci= %d\n",p->constblock.const.ci); 
  50.                 else if( ISREAL(type) )
  51.                      fprintf(diagfile," cd[0]= %e\n",p->constblock.const.cd[0]);
  52.                 else fprintf(diagfile," cd[0]= %e  cd[1]= %e\n",
  53.  
  54. --- 717,726 -----
  55.                    }
  56.                 else  if( ISINT(type) )
  57.                      fprintf(diagfile," ci= %d\n",p->constblock.const.ci); 
  58. + #ifdef GFLOAT
  59. +               else if( ISREAL(type) && type==TYREAL)
  60. +                    fprintf(diagfile," cr[0]= %e\n",p->constblock.const.cr[0]);
  61. + #endif GFLOAT
  62.                 else if( ISREAL(type) )
  63.                      fprintf(diagfile," cd[0]= %e\n",p->constblock.const.cd[0]);
  64.                 else fprintf(diagfile," cd[0]= %e  cd[1]= %e\n",
  65. SHAR_EOF
  66. chmod +x 'bb.c.diff'
  67. if test -f 'conv.c.diff'
  68. then
  69.     echo shar: over-writing existing file "'conv.c.diff'"
  70. fi
  71. cat << \SHAR_EOF > 'conv.c.diff'
  72. *** ../f77/src/f77pass1/conv.c.orig    Tue Oct 29 15:15:46 1985
  73. --- ../f77/src/f77pass1/conv.c    Tue Oct 29 15:22:23 1985
  74. ***************
  75. *** 53,59
  76.   
  77.   
  78.   /*  The following constants are used to check the limits of  */
  79. ! /*  conversions.  Dmaxword is the largest double precision   */
  80.   /*  number which can be converted to a two-byte integer      */
  81.   /*  without overflow.  Dminword is the smallest double       */
  82.   /*  precision value which can be converted to a two-byte     */
  83.  
  84. --- 53,61 -----
  85.   
  86.   
  87.   /*  The following constants are used to check the limits of  */
  88. ! /*  conversions.                                 */
  89. ! 
  90. ! /*  Dmaxword is the largest double precision                    */
  91.   /*  number which can be converted to a two-byte integer      */
  92.   /*  without overflow.  Dminword is the smallest double       */
  93.   /*  precision value which can be converted to a two-byte     */
  94. ***************
  95. *** 57,66
  96.   /*  number which can be converted to a two-byte integer      */
  97.   /*  without overflow.  Dminword is the smallest double       */
  98.   /*  precision value which can be converted to a two-byte     */
  99. ! /*  integer without overflow.  Dmaxint and dminint are the   */
  100. ! /*  analogous values for four-byte integers.                 */
  101. ! 
  102. ! 
  103.   LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  104.   LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  105.   
  106.  
  107. --- 59,66 -----
  108.   /*  number which can be converted to a two-byte integer      */
  109.   /*  without overflow.  Dminword is the smallest double       */
  110.   /*  precision value which can be converted to a two-byte     */
  111. ! /*  integer without overflow.                                */
  112. ! #ifndef GFLOAT
  113.   LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  114.   LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  115.   #else GFLOAT
  116. ***************
  117. *** 63,68
  118.   
  119.   LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  120.   LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  121.   
  122.   LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  123.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  124.  
  125. --- 63,72 -----
  126.   #ifndef GFLOAT
  127.   LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  128.   LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  129. + #else GFLOAT
  130. + LOCAL long dmaxword[] = { 0xffdf40ff, 0xffffffff };
  131. + LOCAL long dminword[] = { 0x0010c100, 0x00000000 };
  132. + #endif GFLOAT
  133.   
  134.   /*  Dmaxint and dminint are the limits for double values     */
  135.   /*  converted to four-byte integers.                         */
  136. ***************
  137. *** 64,69
  138.   LOCAL long dmaxword[] = { 0xfeff47ff, 0xffffffff };
  139.   LOCAL long dminword[] = { 0x00ffc800, 0xffffffff };
  140.   
  141.   LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  142.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  143.   
  144.  
  145. --- 68,79 -----
  146.   LOCAL long dminword[] = { 0x0010c100, 0x00000000 };
  147.   #endif GFLOAT
  148.   
  149. + /*  Dmaxint and dminint are the limits for double values     */
  150. + /*  converted to four-byte integers.                         */
  151. + #ifdef GFLOAT
  152. + LOCAL long dmaxint[]  = { 0xffff41ff, 0xffffffdf };
  153. + LOCAL long dminint[]  = { 0x0000c200, 0xffff0010 };
  154. + #else GFLOAT
  155.   LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  156.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  157.   #endif GFLOAT
  158. ***************
  159. *** 66,71
  160.   
  161.   LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  162.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  163.   
  164.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  165.   LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  166.  
  167. --- 76,82 -----
  168.   #else GFLOAT
  169.   LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  170.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  171. + #endif GFLOAT
  172.   
  173.   #ifndef GFLOAT
  174.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  175. ***************
  176. *** 67,72
  177.   LOCAL long dmaxint[]  = { 0xffff4fff, 0xfffffeff };
  178.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  179.   
  180.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  181.   LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  182.   
  183.  
  184. --- 78,84 -----
  185.   LOCAL long dminint[]  = { 0x0000d000, 0xffff00ff };
  186.   #endif GFLOAT
  187.   
  188. + #ifndef GFLOAT
  189.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  190.   LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  191.   #else GFLOAT
  192. ***************
  193. *** 69,74
  194.   
  195.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  196.   LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  197.   
  198.   
  199.   
  200.  
  201. --- 81,89 -----
  202.   #ifndef GFLOAT
  203.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  204.   LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  205. + #else GFLOAT
  206. + LOCAL long dmaxreal[] = { 0xffff47f7, 0xffffffff };
  207. + LOCAL long dminreal[] = { 0xffffc7f7, 0xffffffff };
  208.   
  209.   /*  Fmaxword and fminword are limits for float to short.     */
  210.   LOCAL long fmaxword[] = { 0xff7f47ff };
  211. ***************
  212. *** 70,75
  213.   LOCAL long dmaxreal[] = { 0xffff7fff, 0xffff7fff };
  214.   LOCAL long dminreal[] = { 0xffffffff, 0xffff7fff };
  215.   
  216.   
  217.   
  218.   /*  The routines which follow are used to convert  */
  219.  
  220. --- 85,98 -----
  221.   LOCAL long dmaxreal[] = { 0xffff47f7, 0xffffffff };
  222.   LOCAL long dminreal[] = { 0xffffc7f7, 0xffffffff };
  223.   
  224. + /*  Fmaxword and fminword are limits for float to short.     */
  225. + LOCAL long fmaxword[] = { 0xff7f47ff };
  226. + LOCAL long fminword[] = { 0x00ffc800 };
  227. + 
  228. + /*  Fmaxint and fminint are the limits for float to int.     */
  229. + LOCAL long fmaxint[]  = { 0xffff4fff };
  230. + LOCAL long fminint[]  = { 0x0000d000 };
  231. + #endif GFLOAT
  232.   
  233.   
  234.   /*  The routines which follow are used to convert  */
  235. ***************
  236. *** 188,193
  237.     register long *rp;
  238.     register double *minp;
  239.     register double *maxp;
  240.     realvalue x;
  241.   
  242.     switch (cp->vtype)
  243.  
  244. --- 211,220 -----
  245.     register long *rp;
  246.     register double *minp;
  247.     register double *maxp;
  248. + #ifdef GFLOAT
  249. +   register float *minpf;
  250. +   register float *maxpf;
  251. + #endif GFLOAT
  252.     realvalue x;
  253.   
  254.     switch (cp->vtype)
  255. ***************
  256. *** 222,227
  257.         break;
  258.   
  259.       case TYREAL:
  260.       case TYDREAL:
  261.       case TYCOMPLEX:
  262.       case TYDCOMPLEX:
  263.  
  264. --- 249,255 -----
  265.         break;
  266.   
  267.       case TYREAL:
  268. + #ifndef GFLOAT
  269.       case TYDREAL:
  270.   #endif GFLOAT
  271.       case TYCOMPLEX:
  272. ***************
  273. *** 223,228
  274.   
  275.       case TYREAL:
  276.       case TYDREAL:
  277.       case TYCOMPLEX:
  278.       case TYDCOMPLEX:
  279.         minp = (double *) dminword;
  280.  
  281. --- 251,257 -----
  282.       case TYREAL:
  283.   #ifndef GFLOAT
  284.       case TYDREAL:
  285. + #endif GFLOAT
  286.       case TYCOMPLEX:
  287.   #ifdef GFLOAT
  288.         minpf = (float *) fminword;
  289. ***************
  290. *** 224,229
  291.       case TYREAL:
  292.       case TYDREAL:
  293.       case TYCOMPLEX:
  294.       case TYDCOMPLEX:
  295.         minp = (double *) dminword;
  296.         maxp = (double *) dmaxword;
  297.  
  298. --- 253,290 -----
  299.       case TYDREAL:
  300.   #endif GFLOAT
  301.       case TYCOMPLEX:
  302. + #ifdef GFLOAT
  303. +       minpf = (float *) fminword;
  304. +       maxpf = (float *) fmaxword;
  305. +       rp = (long *) &(cp->const.cr[0]);
  306. +       x.q.word1 = rp[0];
  307. +       if (x.f.sign == 1 && x.f.exp == 0)
  308. +     {
  309. +       if (badvalue <= 1)
  310. +         {
  311. +           badvalue = 2;
  312. +           err(reserved);
  313. +         }
  314. +       p = errnode();
  315. +     }
  316. +       else if ((float) x.q.word1 >= *minpf && (float) x.q.word1 <= *maxpf)
  317. +     {
  318. +       p = (expptr) mkconst(TYSHORT);
  319. +       p->constblock.const.ci = x.q.word1;
  320. +     }
  321. +       else
  322. +     {
  323. +       if (badvalue <= 1)
  324. +         {
  325. +           badvalue = 2;
  326. +           err(toobig);
  327. +         }
  328. +       p = errnode();
  329. +     }
  330. +       break;
  331. + 
  332. +     case TYDREAL:
  333. + #endif GFLOAT
  334.       case TYDCOMPLEX:
  335.         minp = (double *) dminword;
  336.         maxp = (double *) dmaxword;
  337. ***************
  338. *** 230,235
  339.         rp = (long *) &(cp->const.cd[0]);
  340.         x.q.word1 = rp[0];
  341.         x.q.word2 = rp[1];
  342.         if (x.f.sign == 1 && x.f.exp == 0)
  343.       {
  344.         if (badvalue <= 1)
  345.  
  346. --- 291,297 -----
  347.         rp = (long *) &(cp->const.cd[0]);
  348.         x.q.word1 = rp[0];
  349.         x.q.word2 = rp[1];
  350. + #ifndef GFLOAT
  351.         if (x.f.sign == 1 && x.f.exp == 0)
  352.   #else GFLOAT
  353.         if (x.g.sign == 1 && x.g.exp == 0)
  354. ***************
  355. *** 231,236
  356.         x.q.word1 = rp[0];
  357.         x.q.word2 = rp[1];
  358.         if (x.f.sign == 1 && x.f.exp == 0)
  359.       {
  360.         if (badvalue <= 1)
  361.           {
  362.  
  363. --- 293,301 -----
  364.         x.q.word2 = rp[1];
  365.   #ifndef GFLOAT
  366.         if (x.f.sign == 1 && x.f.exp == 0)
  367. + #else GFLOAT
  368. +       if (x.g.sign == 1 && x.g.exp == 0)
  369. + #endif GFLOAT
  370.       {
  371.         if (badvalue <= 1)
  372.           {
  373. ***************
  374. *** 302,307
  375.     register long *rp;
  376.     register double *minp;
  377.     register double *maxp;
  378.     realvalue x;
  379.   
  380.     switch (cp->vtype)
  381.  
  382. --- 367,376 -----
  383.     register long *rp;
  384.     register double *minp;
  385.     register double *maxp;
  386. + #ifdef GFLOAT
  387. +   register float *minpf;
  388. +   register float *maxpf;
  389. + #endif GFLOAT
  390.     realvalue x;
  391.   
  392.     switch (cp->vtype)
  393. ***************
  394. *** 323,328
  395.         break;
  396.   
  397.       case TYREAL:
  398.       case TYDREAL:
  399.       case TYCOMPLEX:
  400.       case TYDCOMPLEX:
  401.  
  402. --- 392,398 -----
  403.         break;
  404.   
  405.       case TYREAL:
  406. + #ifndef GFLOAT
  407.       case TYDREAL:
  408.   #endif GFLOAT
  409.       case TYCOMPLEX:
  410. ***************
  411. *** 324,329
  412.   
  413.       case TYREAL:
  414.       case TYDREAL:
  415.       case TYCOMPLEX:
  416.       case TYDCOMPLEX:
  417.         minp = (double *) dminint;
  418.  
  419. --- 394,400 -----
  420.       case TYREAL:
  421.   #ifndef GFLOAT
  422.       case TYDREAL:
  423. + #endif GFLOAT
  424.       case TYCOMPLEX:
  425.   #ifdef GFLOAT
  426.         minpf = (float *) fminint;
  427. ***************
  428. *** 325,330
  429.       case TYREAL:
  430.       case TYDREAL:
  431.       case TYCOMPLEX:
  432.       case TYDCOMPLEX:
  433.         minp = (double *) dminint;
  434.         maxp = (double *) dmaxint;
  435.  
  436. --- 396,432 -----
  437.       case TYDREAL:
  438.   #endif GFLOAT
  439.       case TYCOMPLEX:
  440. + #ifdef GFLOAT
  441. +       minpf = (float *) fminint;
  442. +       maxpf = (float *) fmaxint;
  443. +       x.q.word1 = *((long *) &cp->const.cr[0]);
  444. +       if (x.f.sign == 1 && x.f.exp == 0)
  445. +     {
  446. +       if (badvalue <= 1)
  447. +         {
  448. +           badvalue = 2;
  449. +           err(reserved);
  450. +         }
  451. +       p = errnode();
  452. +     }
  453. +       else if (cp->const.cr[0] >= *minpf && cp->const.cr[0] <= *maxpf)
  454. +     {
  455. +       p = (expptr) mkconst(TYLONG);
  456. +       p->constblock.const.ci = cp->const.cr[0];
  457. +     }
  458. +       else
  459. +     {
  460. +       if (badvalue <= 1)
  461. +         {
  462. +           badvalue = 2;
  463. +           err(toobig);
  464. +         }
  465. +       p = errnode();
  466. +     }
  467. +       break;
  468. + 
  469. +     case TYDREAL:
  470. + #endif GFLOAT
  471.       case TYDCOMPLEX:
  472.         minp = (double *) dminint;
  473.         maxp = (double *) dmaxint;
  474. ***************
  475. *** 331,336
  476.         rp = (long *) &(cp->const.cd[0]);
  477.         x.q.word1 = rp[0];
  478.         x.q.word2 = rp[1];
  479.         if (x.f.sign == 1 && x.f.exp == 0)
  480.       {
  481.         if (badvalue <= 1)
  482.  
  483. --- 433,439 -----
  484.         rp = (long *) &(cp->const.cd[0]);
  485.         x.q.word1 = rp[0];
  486.         x.q.word2 = rp[1];
  487. + #ifndef GFLOAT
  488.         if (x.f.sign == 1 && x.f.exp == 0)
  489.   #else GFLOAT
  490.         if (x.g.sign == 1 && x.g.exp == 0)
  491. ***************
  492. *** 332,337
  493.         x.q.word1 = rp[0];
  494.         x.q.word2 = rp[1];
  495.         if (x.f.sign == 1 && x.f.exp == 0)
  496.       {
  497.         if (badvalue <= 1)
  498.           {
  499.  
  500. --- 435,443 -----
  501.         x.q.word2 = rp[1];
  502.   #ifndef GFLOAT
  503.         if (x.f.sign == 1 && x.f.exp == 0)
  504. + #else GFLOAT
  505. +       if (x.g.sign == 1 && x.g.exp == 0)
  506. + #endif GFLOAT
  507.       {
  508.         if (badvalue <= 1)
  509.           {
  510. ***************
  511. *** 403,408
  512.     register double *minp;
  513.     register double *maxp;
  514.     realvalue x;
  515.     float y;
  516.   
  517.     switch (cp->vtype)
  518.  
  519. --- 509,515 -----
  520.     register double *minp;
  521.     register double *maxp;
  522.     realvalue x;
  523. + #ifndef GFLOAT
  524.     float y;
  525.   #endif GFLOAT
  526.   
  527. ***************
  528. *** 404,409
  529.     register double *maxp;
  530.     realvalue x;
  531.     float y;
  532.   
  533.     switch (cp->vtype)
  534.       {
  535.  
  536. --- 511,517 -----
  537.     realvalue x;
  538.   #ifndef GFLOAT
  539.     float y;
  540. + #endif GFLOAT
  541.   
  542.     switch (cp->vtype)
  543.       {
  544. ***************
  545. *** 418,423
  546.       case TYSHORT:
  547.       case TYLONG:
  548.         p = (expptr) mkconst(TYREAL);
  549.         p->constblock.const.cd[0] = cp->const.ci;
  550.         break;
  551.   
  552.  
  553. --- 526,532 -----
  554.       case TYSHORT:
  555.       case TYLONG:
  556.         p = (expptr) mkconst(TYREAL);
  557. + #ifndef GFLOAT
  558.         p->constblock.const.cd[0] = cp->const.ci;
  559.   #else GFLOAT
  560.         p->constblock.const.cr[0] = cp->const.ci;
  561. ***************
  562. *** 419,424
  563.       case TYLONG:
  564.         p = (expptr) mkconst(TYREAL);
  565.         p->constblock.const.cd[0] = cp->const.ci;
  566.         break;
  567.   
  568.       case TYREAL:
  569.  
  570. --- 528,536 -----
  571.         p = (expptr) mkconst(TYREAL);
  572.   #ifndef GFLOAT
  573.         p->constblock.const.cd[0] = cp->const.ci;
  574. + #else GFLOAT
  575. +       p->constblock.const.cr[0] = cp->const.ci;
  576. + #endif GFLOAT
  577.         break;
  578.   
  579.       case TYREAL:
  580. ***************
  581. *** 422,427
  582.         break;
  583.   
  584.       case TYREAL:
  585.       case TYDREAL:
  586.       case TYCOMPLEX:
  587.       case TYDCOMPLEX:
  588.  
  589. --- 534,540 -----
  590.         break;
  591.   
  592.       case TYREAL:
  593. + #ifndef GFLOAT
  594.       case TYDREAL:
  595.   #endif GFLOAT
  596.       case TYCOMPLEX:
  597. ***************
  598. *** 423,428
  599.   
  600.       case TYREAL:
  601.       case TYDREAL:
  602.       case TYCOMPLEX:
  603.       case TYDCOMPLEX:
  604.         minp = (double *) dminreal;
  605.  
  606. --- 536,542 -----
  607.       case TYREAL:
  608.   #ifndef GFLOAT
  609.       case TYDREAL:
  610. + #endif GFLOAT
  611.       case TYCOMPLEX:
  612.   #ifdef GFLOAT
  613.         p = (expptr) mkconst(TYREAL);
  614. ***************
  615. *** 424,429
  616.       case TYREAL:
  617.       case TYDREAL:
  618.       case TYCOMPLEX:
  619.       case TYDCOMPLEX:
  620.         minp = (double *) dminreal;
  621.         maxp = (double *) dmaxreal;
  622.  
  623. --- 538,550 -----
  624.       case TYDREAL:
  625.   #endif GFLOAT
  626.       case TYCOMPLEX:
  627. + #ifdef GFLOAT
  628. +       p = (expptr) mkconst(TYREAL);
  629. +       p->constblock.const.cr[0] = cp->const.cr[0];
  630. +       break;
  631. + 
  632. +     case TYDREAL:
  633. + #endif GFLOAT
  634.       case TYDCOMPLEX:
  635.         minp = (double *) dminreal;
  636.         maxp = (double *) dmaxreal;
  637. ***************
  638. *** 430,435
  639.         rp = (long *) &(cp->const.cd[0]);
  640.         x.q.word1 = rp[0];
  641.         x.q.word2 = rp[1];
  642.         if (x.f.sign == 1 && x.f.exp == 0)
  643.       {
  644.         p = (expptr) mkconst(TYREAL);
  645.  
  646. --- 551,557 -----
  647.         rp = (long *) &(cp->const.cd[0]);
  648.         x.q.word1 = rp[0];
  649.         x.q.word2 = rp[1];
  650. + #ifndef GFLOAT
  651.         if (x.f.sign == 1 && x.f.exp == 0)
  652.   #else GFLOAT
  653.         if (x.g.sign == 1 && x.g.exp == 0)
  654. ***************
  655. *** 431,436
  656.         x.q.word1 = rp[0];
  657.         x.q.word2 = rp[1];
  658.         if (x.f.sign == 1 && x.f.exp == 0)
  659.       {
  660.         p = (expptr) mkconst(TYREAL);
  661.         rp = (long *) &(p->constblock.const.cd[0]);
  662.  
  663. --- 553,561 -----
  664.         x.q.word2 = rp[1];
  665.   #ifndef GFLOAT
  666.         if (x.f.sign == 1 && x.f.exp == 0)
  667. + #else GFLOAT
  668. +       if (x.g.sign == 1 && x.g.exp == 0)
  669. + #endif GFLOAT
  670.       {
  671.         p = (expptr) mkconst(TYREAL);
  672.   #ifndef GFLOAT
  673. ***************
  674. *** 433,438
  675.         if (x.f.sign == 1 && x.f.exp == 0)
  676.       {
  677.         p = (expptr) mkconst(TYREAL);
  678.         rp = (long *) &(p->constblock.const.cd[0]);
  679.         rp[0] = x.q.word1;
  680.       }
  681.  
  682. --- 558,564 -----
  683.   #endif GFLOAT
  684.       {
  685.         p = (expptr) mkconst(TYREAL);
  686. + #ifndef GFLOAT
  687.         rp = (long *) &(p->constblock.const.cd[0]);
  688.         rp[0] = x.q.word1;
  689.   #else GFLOAT
  690. ***************
  691. *** 435,440
  692.         p = (expptr) mkconst(TYREAL);
  693.         rp = (long *) &(p->constblock.const.cd[0]);
  694.         rp[0] = x.q.word1;
  695.       }
  696.         else if (x.d >= *minp && x.d <= *maxp)
  697.       {
  698.  
  699. --- 561,570 -----
  700.   #ifndef GFLOAT
  701.         rp = (long *) &(p->constblock.const.cd[0]);
  702.         rp[0] = x.q.word1;
  703. + #else GFLOAT
  704. + /* Gfloat: Assume that IEEE standard hardware handles exceptions */
  705. +       p->constblock.const.cr[0] = x.d;
  706. + #endif GFLOAT
  707.       }
  708.         else if (x.d >= *minp && x.d <= *maxp)
  709.       {
  710. ***************
  711. *** 439,444
  712.         else if (x.d >= *minp && x.d <= *maxp)
  713.       {
  714.         p = (expptr) mkconst(TYREAL);
  715.         y = x.d;
  716.         p->constblock.const.cd[0] = y;
  717.       }
  718.  
  719. --- 569,575 -----
  720.         else if (x.d >= *minp && x.d <= *maxp)
  721.       {
  722.         p = (expptr) mkconst(TYREAL);
  723. + #ifndef GFLOAT
  724.         y = x.d;
  725.         p->constblock.const.cd[0] = y;
  726.   #else GFLOAT
  727. ***************
  728. *** 441,446
  729.         p = (expptr) mkconst(TYREAL);
  730.         y = x.d;
  731.         p->constblock.const.cd[0] = y;
  732.       }
  733.         else
  734.       {
  735.  
  736. --- 572,580 -----
  737.   #ifndef GFLOAT
  738.         y = x.d;
  739.         p->constblock.const.cd[0] = y;
  740. + #else GFLOAT
  741. +       p->constblock.const.cr[0] = x.d;
  742. + #endif GFLOAT
  743.       }
  744.         else
  745.       {
  746. ***************
  747. *** 517,522
  748.         p->constblock.const.cd[0] = cp->const.ci;
  749.         break;
  750.   
  751.       case TYREAL:
  752.       case TYDREAL:
  753.       case TYCOMPLEX:
  754.  
  755. --- 651,657 -----
  756.         p->constblock.const.cd[0] = cp->const.ci;
  757.         break;
  758.   
  759. + #ifndef GFLOAT
  760.       case TYREAL:
  761.       case TYCOMPLEX:
  762.   #endif GFLOAT
  763. ***************
  764. *** 518,524
  765.         break;
  766.   
  767.       case TYREAL:
  768. -     case TYDREAL:
  769.       case TYCOMPLEX:
  770.       case TYDCOMPLEX:
  771.         p = (expptr) mkconst(TYDREAL);
  772.  
  773. --- 653,658 -----
  774.   
  775.   #ifndef GFLOAT
  776.       case TYREAL:
  777.       case TYCOMPLEX:
  778.   #endif GFLOAT
  779.       case TYDREAL:
  780. ***************
  781. *** 520,525
  782.       case TYREAL:
  783.       case TYDREAL:
  784.       case TYCOMPLEX:
  785.       case TYDCOMPLEX:
  786.         p = (expptr) mkconst(TYDREAL);
  787.         longp = (long *) &(cp->const.cd[0]);
  788.  
  789. --- 654,661 -----
  790.   #ifndef GFLOAT
  791.       case TYREAL:
  792.       case TYCOMPLEX:
  793. + #endif GFLOAT
  794. +     case TYDREAL:
  795.       case TYDCOMPLEX:
  796.         p = (expptr) mkconst(TYDREAL);
  797.   #ifndef GFLOAT
  798. ***************
  799. *** 522,527
  800.       case TYCOMPLEX:
  801.       case TYDCOMPLEX:
  802.         p = (expptr) mkconst(TYDREAL);
  803.         longp = (long *) &(cp->const.cd[0]);
  804.         rp = (long *) &(p->constblock.const.cd[0]);
  805.         rp[0] = longp[0];
  806.  
  807. --- 658,664 -----
  808.       case TYDREAL:
  809.       case TYDCOMPLEX:
  810.         p = (expptr) mkconst(TYDREAL);
  811. + #ifndef GFLOAT
  812.         longp = (long *) &(cp->const.cd[0]);
  813.         rp = (long *) &(p->constblock.const.cd[0]);
  814.         rp[0] = longp[0];
  815. ***************
  816. *** 526,531
  817.         rp = (long *) &(p->constblock.const.cd[0]);
  818.         rp[0] = longp[0];
  819.         rp[1] = longp[1];
  820.         break;
  821.   
  822.       case TYLOGICAL:
  823.  
  824. --- 663,671 -----
  825.         rp = (long *) &(p->constblock.const.cd[0]);
  826.         rp[0] = longp[0];
  827.         rp[1] = longp[1];
  828. + #else GFLOAT
  829. +       p->constblock.const.cd[0] = cp->const.cd[0];
  830. + #endif GFLOAT
  831.         break;
  832.   
  833.   #ifdef GFLOAT
  834. ***************
  835. *** 528,533
  836.         rp[1] = longp[1];
  837.         break;
  838.   
  839.       case TYLOGICAL:
  840.         if (badvalue <= 1)
  841.       {
  842.  
  843. --- 668,681 -----
  844.   #endif GFLOAT
  845.         break;
  846.   
  847. + #ifdef GFLOAT
  848. +     case TYREAL:
  849. +     case TYCOMPLEX:
  850. +       p = (expptr) mkconst(TYDREAL);
  851. +       p->constblock.const.cd[0] = cp->const.cr[0];
  852. +       break;
  853. + 
  854. + #endif GFLOAT
  855.       case TYLOGICAL:
  856.         if (badvalue <= 1)
  857.       {
  858. ***************
  859. *** 576,581
  860.     register long *rp;
  861.     register double *minp;
  862.     register double *maxp;
  863.     realvalue re, im;
  864.     int overflow;
  865.     float x;
  866.  
  867. --- 724,733 -----
  868.     register long *rp;
  869.     register double *minp;
  870.     register double *maxp;
  871. + #ifdef GFLOAT
  872. +   register float *minpf;
  873. +   register float *maxpf;
  874. + #endif GFLOAT
  875.     realvalue re, im;
  876.     int overflow;
  877.     float x;
  878. ***************
  879. *** 598,603
  880.         break;
  881.   
  882.       case TYREAL:
  883.       case TYDREAL:
  884.       case TYCOMPLEX:
  885.       case TYDCOMPLEX:
  886.  
  887. --- 750,756 -----
  888.         break;
  889.   
  890.       case TYREAL:
  891. + #ifndef GFLOAT
  892.       case TYDREAL:
  893.   #endif GFLOAT
  894.       case TYCOMPLEX:
  895. ***************
  896. *** 599,604
  897.   
  898.       case TYREAL:
  899.       case TYDREAL:
  900.       case TYCOMPLEX:
  901.       case TYDCOMPLEX:
  902.         overflow = 0;
  903.  
  904. --- 752,758 -----
  905.       case TYREAL:
  906.   #ifndef GFLOAT
  907.       case TYDREAL:
  908. + #endif GFLOAT
  909.       case TYCOMPLEX:
  910.   #ifdef GFLOAT
  911.         overflow = 0;
  912. ***************
  913. *** 600,605
  914.       case TYREAL:
  915.       case TYDREAL:
  916.       case TYCOMPLEX:
  917.       case TYDCOMPLEX:
  918.         overflow = 0;
  919.         minp = (double *) dminreal;
  920.  
  921. --- 754,768 -----
  922.       case TYDREAL:
  923.   #endif GFLOAT
  924.       case TYCOMPLEX:
  925. + #ifdef GFLOAT
  926. +       overflow = 0;
  927. +       p = (expptr) mkconst(TYCOMPLEX);
  928. +       p->constblock.const.cr[0] = cp->const.cr[0];
  929. +       p->constblock.const.cr[1] = cp->const.cr[1];
  930. +       break;
  931. + 
  932. +     case TYDREAL:
  933. + #endif GFLOAT
  934.       case TYDCOMPLEX:
  935.         overflow = 0;
  936.         minp = (double *) dminreal;
  937. ***************
  938. *** 609,614
  939.         re.q.word2 = rp[1];
  940.         im.q.word1 = rp[2];
  941.         im.q.word2 = rp[3];
  942.         if (((re.f.sign == 0 || re.f.exp != 0) &&
  943.          (re.d < *minp || re.d > *maxp))       ||
  944.         ((im.f.sign == 0 || re.f.exp != 0) &&
  945.  
  946. --- 772,778 -----
  947.         re.q.word2 = rp[1];
  948.         im.q.word1 = rp[2];
  949.         im.q.word2 = rp[3];
  950. + #ifndef GFLOAT
  951.         if (((re.f.sign == 0 || re.f.exp != 0) &&
  952.   #else GFLOAT
  953.         if (((re.g.sign == 0 || re.g.exp != 0) &&
  954. ***************
  955. *** 610,615
  956.         im.q.word1 = rp[2];
  957.         im.q.word2 = rp[3];
  958.         if (((re.f.sign == 0 || re.f.exp != 0) &&
  959.          (re.d < *minp || re.d > *maxp))       ||
  960.         ((im.f.sign == 0 || re.f.exp != 0) &&
  961.          (im.d < *minp || re.d > *maxp)))
  962.  
  963. --- 774,782 -----
  964.         im.q.word2 = rp[3];
  965.   #ifndef GFLOAT
  966.         if (((re.f.sign == 0 || re.f.exp != 0) &&
  967. + #else GFLOAT
  968. +       if (((re.g.sign == 0 || re.g.exp != 0) &&
  969. + #endif GFLOAT
  970.          (re.d < *minp || re.d > *maxp))       ||
  971.   #ifndef GFLOAT
  972.         ((im.f.sign == 0 || re.f.exp != 0) &&
  973. ***************
  974. *** 611,616
  975.         im.q.word2 = rp[3];
  976.         if (((re.f.sign == 0 || re.f.exp != 0) &&
  977.          (re.d < *minp || re.d > *maxp))       ||
  978.         ((im.f.sign == 0 || re.f.exp != 0) &&
  979.          (im.d < *minp || re.d > *maxp)))
  980.       {
  981.  
  982. --- 778,784 -----
  983.         if (((re.g.sign == 0 || re.g.exp != 0) &&
  984.   #endif GFLOAT
  985.          (re.d < *minp || re.d > *maxp))       ||
  986. + #ifndef GFLOAT
  987.         ((im.f.sign == 0 || re.f.exp != 0) &&
  988.   #else GFLOAT
  989.         ((im.g.sign == 0 || re.g.exp != 0) &&
  990. ***************
  991. *** 612,617
  992.         if (((re.f.sign == 0 || re.f.exp != 0) &&
  993.          (re.d < *minp || re.d > *maxp))       ||
  994.         ((im.f.sign == 0 || re.f.exp != 0) &&
  995.          (im.d < *minp || re.d > *maxp)))
  996.       {
  997.         if (badvalue <= 1)
  998.  
  999. --- 780,788 -----
  1000.          (re.d < *minp || re.d > *maxp))       ||
  1001.   #ifndef GFLOAT
  1002.         ((im.f.sign == 0 || re.f.exp != 0) &&
  1003. + #else GFLOAT
  1004. +       ((im.g.sign == 0 || re.g.exp != 0) &&
  1005. + #endif GFLOAT
  1006.          (im.d < *minp || re.d > *maxp)))
  1007.       {
  1008.         if (badvalue <= 1)
  1009. ***************
  1010. *** 624,629
  1011.         else
  1012.       {
  1013.         p = (expptr) mkconst(TYCOMPLEX);
  1014.         if (re.f.sign == 1 && re.f.exp == 0)
  1015.           re.q.word2 = 0;
  1016.         else
  1017.  
  1018. --- 795,801 -----
  1019.         else
  1020.       {
  1021.         p = (expptr) mkconst(TYCOMPLEX);
  1022. + #ifndef GFLOAT
  1023.         if (re.f.sign == 1 && re.f.exp == 0)
  1024.           re.q.word2 = 0;
  1025.         else
  1026. ***************
  1027. *** 643,648
  1028.         rp[1] = re.q.word2;
  1029.         rp[2] = im.q.word1;
  1030.         rp[3] = im.q.word2;
  1031.       }
  1032.         break;
  1033.   
  1034.  
  1035. --- 815,824 -----
  1036.         rp[1] = re.q.word2;
  1037.         rp[2] = im.q.word1;
  1038.         rp[3] = im.q.word2;
  1039. + #else GFLOAT
  1040. +           p->constblock.const.cr[0] = cp->const.cd[0];
  1041. +           p->constblock.const.cr[0] = cp->const.cd[1];
  1042. + #endif GFLOAT
  1043.       }
  1044.         break;
  1045.   
  1046. ***************
  1047. *** 711,716
  1048.         break;
  1049.   
  1050.       case TYREAL:
  1051.       case TYDREAL:
  1052.       case TYCOMPLEX:
  1053.       case TYDCOMPLEX:
  1054.  
  1055. --- 887,893 -----
  1056.         break;
  1057.   
  1058.       case TYREAL:
  1059. + #ifndef GFLOAT
  1060.       case TYDREAL:
  1061.   #endif GFLOAT
  1062.       case TYCOMPLEX:
  1063. ***************
  1064. *** 712,717
  1065.   
  1066.       case TYREAL:
  1067.       case TYDREAL:
  1068.       case TYCOMPLEX:
  1069.       case TYDCOMPLEX:
  1070.         p = (expptr) mkconst(TYDCOMPLEX);
  1071.  
  1072. --- 889,895 -----
  1073.       case TYREAL:
  1074.   #ifndef GFLOAT
  1075.       case TYDREAL:
  1076. + #endif GFLOAT
  1077.       case TYCOMPLEX:
  1078.   #ifdef GFLOAT
  1079.         p = (expptr) mkconst(TYDCOMPLEX);
  1080. ***************
  1081. *** 713,718
  1082.       case TYREAL:
  1083.       case TYDREAL:
  1084.       case TYCOMPLEX:
  1085.       case TYDCOMPLEX:
  1086.         p = (expptr) mkconst(TYDCOMPLEX);
  1087.         longp = (long *) &(cp->const.cd[0]);
  1088.  
  1089. --- 891,904 -----
  1090.       case TYDREAL:
  1091.   #endif GFLOAT
  1092.       case TYCOMPLEX:
  1093. + #ifdef GFLOAT
  1094. +       p = (expptr) mkconst(TYDCOMPLEX);
  1095. +       p->constblock.const.cd[0] = cp->const.cr[0];
  1096. +       p->constblock.const.cd[1] = cp->const.cr[1];
  1097. +       break;
  1098. + 
  1099. +     case TYDREAL:
  1100. + #endif GFLOAT
  1101.       case TYDCOMPLEX:
  1102.         p = (expptr) mkconst(TYDCOMPLEX);
  1103.   #ifndef GFLOAT
  1104. ***************
  1105. *** 715,720
  1106.       case TYCOMPLEX:
  1107.       case TYDCOMPLEX:
  1108.         p = (expptr) mkconst(TYDCOMPLEX);
  1109.         longp = (long *) &(cp->const.cd[0]);
  1110.         rp = (long *) &(p->constblock.const.cd[0]);
  1111.         rp[0] = longp[0];
  1112.  
  1113. --- 901,907 -----
  1114.   #endif GFLOAT
  1115.       case TYDCOMPLEX:
  1116.         p = (expptr) mkconst(TYDCOMPLEX);
  1117. + #ifndef GFLOAT
  1118.         longp = (long *) &(cp->const.cd[0]);
  1119.         rp = (long *) &(p->constblock.const.cd[0]);
  1120.         rp[0] = longp[0];
  1121. ***************
  1122. *** 721,726
  1123.         rp[1] = longp[1];
  1124.         rp[2] = longp[2];
  1125.         rp[3] = longp[3];
  1126.         break;
  1127.   
  1128.       case TYLOGICAL:
  1129.  
  1130. --- 908,917 -----
  1131.         rp[1] = longp[1];
  1132.         rp[2] = longp[2];
  1133.         rp[3] = longp[3];
  1134. + #else GFLOAT
  1135. +       p->constblock.const.cd[0] = cp->const.cd[0];
  1136. +       p->constblock.const.cd[1] = cp->const.cd[1];
  1137. + #endif GFLOAT
  1138.         break;
  1139.   
  1140.       case TYLOGICAL:
  1141. SHAR_EOF
  1142. chmod +x 'conv.c.diff'
  1143. if test -f 'expr.c.diff'
  1144. then
  1145.     echo shar: over-writing existing file "'expr.c.diff'"
  1146. fi
  1147. cat << \SHAR_EOF > 'expr.c.diff'
  1148. *** ../f77/src/f77pass1/expr.c.orig    Tue Oct 29 15:15:54 1985
  1149. --- ../f77/src/f77pass1/expr.c    Tue Oct 29 15:22:42 1985
  1150. ***************
  1151. *** 151,157
  1152.   register Constp p;
  1153.   
  1154.   p = mkconst(t);
  1155. ! p->const.cd[0] = d;
  1156.   return( (expptr) p );
  1157.   }
  1158.   
  1159.  
  1160. --- 151,162 -----
  1161.   register Constp p;
  1162.   
  1163.   p = mkconst(t);
  1164. ! #ifdef GFLOAT
  1165. ! if (t==TYREAL)
  1166. !     p->const.cr[0] = d;
  1167. ! else
  1168. ! #endif GFLOAT
  1169. !     p->const.cd[0] = d;
  1170.   return( (expptr) p );
  1171.   }
  1172.   
  1173. ***************
  1174. *** 241,246
  1175.       p = mkconst( (rtype==TYDREAL||itype==TYDREAL) ? TYDCOMPLEX : TYCOMPLEX);
  1176.       if( ISINT(rtype) )
  1177.           p->const.cd[0] = realp->constblock.const.ci;
  1178.       else    p->const.cd[0] = realp->constblock.const.cd[0];
  1179.       if( ISINT(itype) )
  1180.           p->const.cd[1] = imagp->constblock.const.ci;
  1181.  
  1182. --- 246,255 -----
  1183.       p = mkconst( (rtype==TYDREAL||itype==TYDREAL) ? TYDCOMPLEX : TYCOMPLEX);
  1184.       if( ISINT(rtype) )
  1185.           p->const.cd[0] = realp->constblock.const.ci;
  1186. + #ifdef GFLOAT
  1187. +     else if (rtype==TYREAL || itype==TYREAL) 
  1188. +         p->const.cr[0] = realp->constblock.const.cr[0];
  1189. + #endif GFLOAT
  1190.       else    p->const.cd[0] = realp->constblock.const.cd[0];
  1191.       if( ISINT(itype) )
  1192.           p->const.cd[1] = imagp->constblock.const.ci;
  1193. ***************
  1194. *** 244,249
  1195.       else    p->const.cd[0] = realp->constblock.const.cd[0];
  1196.       if( ISINT(itype) )
  1197.           p->const.cd[1] = imagp->constblock.const.ci;
  1198.       else    p->const.cd[1] = imagp->constblock.const.cd[0];
  1199.       }
  1200.   else
  1201.  
  1202. --- 253,262 -----
  1203.       else    p->const.cd[0] = realp->constblock.const.cd[0];
  1204.       if( ISINT(itype) )
  1205.           p->const.cd[1] = imagp->constblock.const.ci;
  1206. + #ifdef GFLOAT
  1207. +     else if (rtype==TYREAL || itype==TYREAL) 
  1208. +         p->const.cr[1] = imagp->constblock.const.cr[0];
  1209. + #endif GFLOAT
  1210.       else    p->const.cd[1] = imagp->constblock.const.cd[0];
  1211.       }
  1212.   else
  1213. ***************
  1214. *** 2255,2261
  1215.               lv->ci = rv->ccp[0];
  1216.           else if( ISINT(rt) )
  1217.               lv->ci = rv->ci;
  1218. !         else    lv->ci = rv->cd[0];
  1219.           break;
  1220.   
  1221.       case TYCOMPLEX:
  1222.  
  1223. --- 2268,2278 -----
  1224.               lv->ci = rv->ccp[0];
  1225.           else if( ISINT(rt) )
  1226.               lv->ci = rv->ci;
  1227. ! #ifdef GFLOAT
  1228. !         else if (rt==TYREAL || rt==TYCOMPLEX)
  1229. !                    lv->ci = rv->cr[0]; /* should test */
  1230. ! #endif GFLOAT
  1231. !           else    lv->ci = rv->cd[0];
  1232.           break;
  1233.   
  1234.       case TYCOMPLEX: 
  1235. ***************
  1236. *** 2258,2264
  1237.           else    lv->ci = rv->cd[0];
  1238.           break;
  1239.   
  1240. !     case TYCOMPLEX:
  1241.       case TYDCOMPLEX:
  1242.           switch(rt)
  1243.               {
  1244.  
  1245. --- 2275,2305 -----
  1246.             else    lv->ci = rv->cd[0];
  1247.           break;
  1248.   
  1249. !     case TYCOMPLEX: 
  1250. ! #ifdef GFLOAT
  1251. !         switch(rt)
  1252. !             {
  1253. !             case TYSHORT:
  1254. !             case TYLONG:
  1255. !                 /* fall through and do real assignment of
  1256. !                    first element */
  1257. !             case TYREAL:
  1258. !             case TYDREAL:
  1259. !                 lv->cr[1] = 0; break;
  1260. !             case TYCOMPLEX:
  1261. !                 lv->cr[1] = rv->cr[1]; break;
  1262. !             case TYDCOMPLEX: /* should check range here */
  1263. !                 lv->cr[1] = rv->cd[1]; break;
  1264. !             }
  1265. !     case TYREAL:
  1266. !         if( ISINT(rt) )
  1267. !             lv->cr[0] = rv->ci;
  1268. !         else if (rt==TYREAL || rt==TYCOMPLEX) 
  1269. !             lv->cr[0] = rv->cr[0];
  1270. !         else    lv->cr[0] = rv->cd[0]; /* should test range */
  1271. !         break;
  1272. ! 
  1273. ! #endif GFLOAT
  1274.       case TYDCOMPLEX:
  1275.           switch(rt)
  1276.               {
  1277. ***************
  1278. *** 2270,2276
  1279.               case TYREAL:
  1280.               case TYDREAL:
  1281.                   lv->cd[1] = 0; break;
  1282. !             case TYCOMPLEX:
  1283.               case TYDCOMPLEX:
  1284.                   lv->cd[1] = rv->cd[1]; break;
  1285.               }
  1286.  
  1287. --- 2311,2320 -----
  1288.               case TYREAL:
  1289.               case TYDREAL:
  1290.                   lv->cd[1] = 0; break;
  1291. !             case TYCOMPLEX: 
  1292. ! #ifdef GFLOAT
  1293. !                 lv->cd[1] = rv->cr[1]; break;
  1294. ! #endif GFLOAT
  1295.               case TYDCOMPLEX:
  1296.                   lv->cd[1] = rv->cd[1]; break;
  1297.               }
  1298. ***************
  1299. *** 2274,2280
  1300.               case TYDCOMPLEX:
  1301.                   lv->cd[1] = rv->cd[1]; break;
  1302.               }
  1303. ! 
  1304.       case TYREAL:
  1305.       case TYDREAL:
  1306.           if( ISINT(rt) )
  1307.  
  1308. --- 2318,2324 -----
  1309.               case TYDCOMPLEX:
  1310.                   lv->cd[1] = rv->cd[1]; break;
  1311.               }
  1312. ! #ifndef GFLOAT
  1313.       case TYREAL:
  1314.   #endif GFLOAT
  1315.       case TYDREAL:
  1316. ***************
  1317. *** 2276,2281
  1318.               }
  1319.   
  1320.       case TYREAL:
  1321.       case TYDREAL:
  1322.           if( ISINT(rt) )
  1323.               lv->cd[0] = rv->ci;
  1324.  
  1325. --- 2320,2326 -----
  1326.               }
  1327.   #ifndef GFLOAT
  1328.       case TYREAL:
  1329. + #endif GFLOAT
  1330.       case TYDREAL:
  1331.           if( ISINT(rt) )
  1332.               lv->cd[0] = rv->ci;
  1333. ***************
  1334. *** 2279,2284
  1335.       case TYDREAL:
  1336.           if( ISINT(rt) )
  1337.               lv->cd[0] = rv->ci;
  1338.           else    lv->cd[0] = rv->cd[0];
  1339.           break;
  1340.   
  1341.  
  1342. --- 2324,2333 -----
  1343.       case TYDREAL:
  1344.           if( ISINT(rt) )
  1345.               lv->cd[0] = rv->ci;
  1346. + #ifdef GFLOAT
  1347. +         else if (rt==TYREAL || rt==TYCOMPLEX) 
  1348. +             lv->cd[0] = rv->cr[0];
  1349. + #endif GFLOAT
  1350.           else    lv->cd[0] = rv->cd[0];
  1351.           break;
  1352.   
  1353. ***************
  1354. *** 2300,2306
  1355.           p->const.ci = - p->const.ci;
  1356.           break;
  1357.   
  1358. !     case TYCOMPLEX:
  1359.       case TYDCOMPLEX:
  1360.           p->const.cd[1] = - p->const.cd[1];
  1361.           /* fall through and do the real parts */
  1362.  
  1363. --- 2349,2362 -----
  1364.           p->const.ci = - p->const.ci;
  1365.           break;
  1366.   
  1367. !     case TYCOMPLEX: 
  1368. ! #ifdef GFLOAT
  1369. !         p->const.cr[1] = - p->const.cr[1];
  1370. !         /* fall through and do the real parts */
  1371. !     case TYREAL:
  1372. !         p->const.cr[0] = - p->const.cr[0];
  1373. !         break;
  1374. ! #endif GFLOAT
  1375.       case TYDCOMPLEX:
  1376.           p->const.cd[1] = - p->const.cd[1];
  1377.           /* fall through and do the real parts */
  1378. ***************
  1379. *** 2304,2309
  1380.       case TYDCOMPLEX:
  1381.           p->const.cd[1] = - p->const.cd[1];
  1382.           /* fall through and do the real parts */
  1383.       case TYREAL:
  1384.       case TYDREAL:
  1385.           p->const.cd[0] = - p->const.cd[0];
  1386.  
  1387. --- 2360,2366 -----
  1388.       case TYDCOMPLEX:
  1389.           p->const.cd[1] = - p->const.cd[1];
  1390.           /* fall through and do the real parts */
  1391. + #ifndef GFLOAT
  1392.       case TYREAL:
  1393.   #endif GFLOAT
  1394.       case TYDREAL:
  1395. ***************
  1396. *** 2305,2310
  1397.           p->const.cd[1] = - p->const.cd[1];
  1398.           /* fall through and do the real parts */
  1399.       case TYREAL:
  1400.       case TYDREAL:
  1401.           p->const.cd[0] = - p->const.cd[0];
  1402.           break;
  1403.  
  1404. --- 2362,2368 -----
  1405.           /* fall through and do the real parts */
  1406.   #ifndef GFLOAT
  1407.       case TYREAL:
  1408. + #endif GFLOAT
  1409.       case TYDREAL:
  1410.           p->const.cd[0] = - p->const.cd[0];
  1411.           break;
  1412. ***************
  1413. *** 2329,2335
  1414.       case TYLONG:
  1415.           powp->ci = 1;
  1416.           break;
  1417. !     case TYCOMPLEX:
  1418.       case TYDCOMPLEX:
  1419.           powp->cd[1] = 0;
  1420.       case TYREAL:
  1421.  
  1422. --- 2387,2399 -----
  1423.       case TYLONG:
  1424.           powp->ci = 1;
  1425.           break;
  1426. !     case TYCOMPLEX: 
  1427. ! #ifdef GFLOAT
  1428. !         powp->cr[1] = 0;
  1429. !     case TYREAL:
  1430. !         powp->cr[0] = 1;
  1431. !         break;
  1432. ! #endif GFLOAT
  1433.       case TYDCOMPLEX:
  1434.           powp->cd[1] = 0;
  1435.   #ifndef GFLOAT
  1436. ***************
  1437. *** 2332,2337
  1438.       case TYCOMPLEX:
  1439.       case TYDCOMPLEX:
  1440.           powp->cd[1] = 0;
  1441.       case TYREAL:
  1442.       case TYDREAL:
  1443.           powp->cd[0] = 1;
  1444.  
  1445. --- 2396,2402 -----
  1446.   #endif GFLOAT
  1447.       case TYDCOMPLEX:
  1448.           powp->cd[1] = 0;
  1449. + #ifndef GFLOAT
  1450.       case TYREAL:
  1451.   #endif GFLOAT
  1452.       case TYDREAL:
  1453. ***************
  1454. *** 2333,2338
  1455.       case TYDCOMPLEX:
  1456.           powp->cd[1] = 0;
  1457.       case TYREAL:
  1458.       case TYDREAL:
  1459.           powp->cd[0] = 1;
  1460.           break;
  1461.  
  1462. --- 2398,2404 -----
  1463.           powp->cd[1] = 0;
  1464.   #ifndef GFLOAT
  1465.       case TYREAL:
  1466. + #endif GFLOAT
  1467.       case TYDREAL:
  1468.           powp->cd[0] = 1;
  1469.           break;
  1470. ***************
  1471. *** 2383,2388
  1472.   
  1473.   /* do constant operation cp = a op b */
  1474.   
  1475.   
  1476.   LOCAL consbinop(opcode, type, cp, ap, bp)
  1477.   int opcode, type;
  1478.  
  1479. --- 2449,2457 -----
  1480.   
  1481.   /* do constant operation cp = a op b */
  1482.   
  1483. + #ifdef GFLOAT
  1484. + struct rcomplex { double real, imag; };
  1485. + #endif GFLOAT
  1486.   
  1487.   LOCAL consbinop(opcode, type, cp, ap, bp)
  1488.   int opcode, type;
  1489. ***************
  1490. *** 2390,2395
  1491.   {
  1492.   int k;
  1493.   double temp;
  1494.   
  1495.   switch(opcode)
  1496.       {
  1497.  
  1498. --- 2459,2467 -----
  1499.   {
  1500.   int k;
  1501.   double temp;
  1502. + #ifdef GFLOAT
  1503. + struct rcomplex fr, ar, br;
  1504. + #endif GFLOAT
  1505.   
  1506.   switch(opcode)
  1507.       {
  1508. ***************
  1509. *** 2401,2406
  1510.                   cp->ci = ap->ci + bp->ci;
  1511.                   break;
  1512.               case TYCOMPLEX:
  1513.               case TYDCOMPLEX:
  1514.                   cp->cd[1] = ap->cd[1] + bp->cd[1];
  1515.               case TYREAL:
  1516.  
  1517. --- 2473,2484 -----
  1518.                   cp->ci = ap->ci + bp->ci;
  1519.                   break;
  1520.               case TYCOMPLEX:
  1521. + #ifdef GFLOAT
  1522. +                 cp->cr[1] = ap->cr[1] + bp->cr[1];
  1523. +             case TYREAL:
  1524. +                 cp->cr[0] = ap->cr[0] + bp->cr[0];
  1525. +                 break;
  1526. + #endif GFLOAT
  1527.               case TYDCOMPLEX:
  1528.                   cp->cd[1] = ap->cd[1] + bp->cd[1];
  1529.   #ifndef GFLOAT
  1530. ***************
  1531. *** 2403,2408
  1532.               case TYCOMPLEX:
  1533.               case TYDCOMPLEX:
  1534.                   cp->cd[1] = ap->cd[1] + bp->cd[1];
  1535.               case TYREAL:
  1536.               case TYDREAL:
  1537.                   cp->cd[0] = ap->cd[0] + bp->cd[0];
  1538.  
  1539. --- 2481,2487 -----
  1540.   #endif GFLOAT
  1541.               case TYDCOMPLEX:
  1542.                   cp->cd[1] = ap->cd[1] + bp->cd[1];
  1543. + #ifndef GFLOAT
  1544.               case TYREAL:
  1545.   #endif GFLOAT
  1546.               case TYDREAL:
  1547. ***************
  1548. *** 2404,2409
  1549.               case TYDCOMPLEX:
  1550.                   cp->cd[1] = ap->cd[1] + bp->cd[1];
  1551.               case TYREAL:
  1552.               case TYDREAL:
  1553.                   cp->cd[0] = ap->cd[0] + bp->cd[0];
  1554.                   break;
  1555.  
  1556. --- 2483,2489 -----
  1557.                   cp->cd[1] = ap->cd[1] + bp->cd[1];
  1558.   #ifndef GFLOAT
  1559.               case TYREAL:
  1560. + #endif GFLOAT
  1561.               case TYDREAL:
  1562.                   cp->cd[0] = ap->cd[0] + bp->cd[0];
  1563.                   break;
  1564. ***************
  1565. *** 2417,2423
  1566.               case TYLONG:
  1567.                   cp->ci = ap->ci - bp->ci;
  1568.                   break;
  1569. !             case TYCOMPLEX:
  1570.               case TYDCOMPLEX:
  1571.                   cp->cd[1] = ap->cd[1] - bp->cd[1];
  1572.               case TYREAL:
  1573.  
  1574. --- 2497,2509 -----
  1575.               case TYLONG:
  1576.                   cp->ci = ap->ci - bp->ci;
  1577.                   break;
  1578. !             case TYCOMPLEX: 
  1579. ! #ifdef GFLOAT
  1580. !                 cp->cr[1] = ap->cr[1] - bp->cr[1];
  1581. !             case TYREAL:
  1582. !                 cp->cr[0] = ap->cr[0] - bp->cr[0];
  1583. !                 break;
  1584. ! #endif GFLOAT
  1585.               case TYDCOMPLEX:
  1586.                   cp->cd[1] = ap->cd[1] - bp->cd[1];
  1587.   #ifndef GFLOAT
  1588. ***************
  1589. *** 2420,2425
  1590.               case TYCOMPLEX:
  1591.               case TYDCOMPLEX:
  1592.                   cp->cd[1] = ap->cd[1] - bp->cd[1];
  1593.               case TYREAL:
  1594.               case TYDREAL:
  1595.                   cp->cd[0] = ap->cd[0] - bp->cd[0];
  1596.  
  1597. --- 2506,2512 -----
  1598.   #endif GFLOAT
  1599.               case TYDCOMPLEX:
  1600.                   cp->cd[1] = ap->cd[1] - bp->cd[1];
  1601. + #ifndef GFLOAT
  1602.               case TYREAL:
  1603.   #endif GFLOAT
  1604.               case TYDREAL:
  1605. ***************
  1606. *** 2421,2426
  1607.               case TYDCOMPLEX:
  1608.                   cp->cd[1] = ap->cd[1] - bp->cd[1];
  1609.               case TYREAL:
  1610.               case TYDREAL:
  1611.                   cp->cd[0] = ap->cd[0] - bp->cd[0];
  1612.                   break;
  1613.  
  1614. --- 2508,2514 -----
  1615.                   cp->cd[1] = ap->cd[1] - bp->cd[1];
  1616.   #ifndef GFLOAT
  1617.               case TYREAL:
  1618. + #endif GFLOAT
  1619.               case TYDREAL:
  1620.                   cp->cd[0] = ap->cd[0] - bp->cd[0];
  1621.                   break;
  1622. ***************
  1623. *** 2434,2440
  1624.               case TYLONG:
  1625.                   cp->ci = ap->ci * bp->ci;
  1626.                   break;
  1627. !             case TYREAL:
  1628.               case TYDREAL:
  1629.                   cp->cd[0] = ap->cd[0] * bp->cd[0];
  1630.                   break;
  1631.  
  1632. --- 2522,2532 -----
  1633.               case TYLONG:
  1634.                   cp->ci = ap->ci * bp->ci;
  1635.                   break;
  1636. !             case TYREAL: 
  1637. ! #ifdef GFLOAT
  1638. !                 cp->cr[0] = ap->cr[0] * bp->cr[0];
  1639. !                 break;
  1640. ! #endif GFLOAT
  1641.               case TYDREAL:
  1642.                   cp->cd[0] = ap->cd[0] * bp->cd[0];
  1643.                   break;
  1644. ***************
  1645. *** 2439,2444
  1646.                   cp->cd[0] = ap->cd[0] * bp->cd[0];
  1647.                   break;
  1648.               case TYCOMPLEX:
  1649.               case TYDCOMPLEX:
  1650.                   temp = ap->cd[0] * bp->cd[0] -
  1651.                           ap->cd[1] * bp->cd[1] ;
  1652.  
  1653. --- 2531,2544 -----
  1654.                   cp->cd[0] = ap->cd[0] * bp->cd[0];
  1655.                   break;
  1656.               case TYCOMPLEX:
  1657. + #ifdef GFLOAT
  1658. +                 temp = ap->cr[0] * bp->cr[0] -
  1659. +                         ap->cr[1] * bp->cr[1] ;
  1660. +                 cp->cr[1] = ap->cr[0] * bp->cr[1] +
  1661. +                         ap->cr[1] * bp->cr[0] ;
  1662. +                 cp->cr[0] = temp;
  1663. +                 break;
  1664. + #endif GFLOAT
  1665.               case TYDCOMPLEX:
  1666.                   temp = ap->cd[0] * bp->cd[0] -
  1667.                           ap->cd[1] * bp->cd[1] ;
  1668. ***************
  1669. *** 2455,2461
  1670.               case TYLONG:
  1671.                   cp->ci = ap->ci / bp->ci;
  1672.                   break;
  1673. !             case TYREAL:
  1674.               case TYDREAL:
  1675.                   cp->cd[0] = ap->cd[0] / bp->cd[0];
  1676.                   break;
  1677.  
  1678. --- 2555,2565 -----
  1679.               case TYLONG:
  1680.                   cp->ci = ap->ci / bp->ci;
  1681.                   break;
  1682. !             case TYREAL: 
  1683. ! #ifdef GFLOAT
  1684. !                 cp->cr[0] = ap->cr[0] / bp->cr[0];
  1685. !                 break;
  1686. ! #endif GFLOAT
  1687.               case TYDREAL:
  1688.                   cp->cd[0] = ap->cd[0] / bp->cd[0];
  1689.                   break;
  1690. ***************
  1691. *** 2460,2465
  1692.                   cp->cd[0] = ap->cd[0] / bp->cd[0];
  1693.                   break;
  1694.               case TYCOMPLEX:
  1695.               case TYDCOMPLEX:
  1696.                   zdiv(cp,ap,bp);
  1697.                   break;
  1698.  
  1699. --- 2564,2579 -----
  1700.                   cp->cd[0] = ap->cd[0] / bp->cd[0];
  1701.                   break;
  1702.               case TYCOMPLEX:
  1703. + #ifdef GFLOAT
  1704. +                 ar.real = ap->cr[0];
  1705. +                  ar.imag = ap->cr[1];
  1706. +                 br.real = bp->cr[0];
  1707. +                 br.imag = bp->cr[1];
  1708. +                 zdiv(fr,ar,br);
  1709. +                 cp->cr[0] = fr.real; /* should test */
  1710. +                 cp->cr[1] = fr.imag;
  1711. +                 break;
  1712. + #endif GFLOAT
  1713.               case TYDCOMPLEX:
  1714.                   zdiv(cp,ap,bp);
  1715.                   break;
  1716. ***************
  1717. *** 2486,2492
  1718.                       k = 0;
  1719.                   else    k = 1;
  1720.                   break;
  1721. !             case TYREAL:
  1722.               case TYDREAL:
  1723.                   if(ap->cd[0] < bp->cd[0])
  1724.                       k = -1;
  1725.  
  1726. --- 2600,2606 -----
  1727.                       k = 0;
  1728.                   else    k = 1;
  1729.                   break;
  1730. !             case TYREAL: /*assume this works for G format floats */
  1731.               case TYDREAL:
  1732.                   if(ap->cd[0] < bp->cd[0])
  1733.                       k = -1;
  1734. ***************
  1735. *** 2494,2500
  1736.                       k = 0;
  1737.                   else    k = 1;
  1738.                   break;
  1739. !             case TYCOMPLEX:
  1740.               case TYDCOMPLEX:
  1741.                   if(ap->cd[0] == bp->cd[0] &&
  1742.                      ap->cd[1] == bp->cd[1] )
  1743.  
  1744. --- 2608,2621 -----
  1745.                       k = 0;
  1746.                   else    k = 1;
  1747.                   break;
  1748. !             case TYCOMPLEX: 
  1749. ! #ifdef GFLOAT
  1750. !                 if(ap->cr[0] == bp->cr[0] &&
  1751. !                    ap->cr[1] == bp->cr[1] )
  1752. !                     k = 0;
  1753. !                 else    k = 1;
  1754. !                 break;
  1755. ! #endif GFLOAT
  1756.               case TYDCOMPLEX:
  1757.                   if(ap->cd[0] == bp->cd[0] &&
  1758.                      ap->cd[1] == bp->cd[1] )
  1759. ***************
  1760. *** 2547,2553
  1761.           if(p->constblock.const.ci < 0) return(-1);
  1762.           return(0);
  1763.   
  1764. !     case TYREAL:
  1765.       case TYDREAL:
  1766.           if(p->constblock.const.cd[0] > 0) return(1);
  1767.           if(p->constblock.const.cd[0] < 0) return(-1);
  1768.  
  1769. --- 2668,2679 -----
  1770.           if(p->constblock.const.ci < 0) return(-1);
  1771.           return(0);
  1772.   
  1773. !     case TYREAL: 
  1774. ! #ifdef GFLOAT
  1775. !         if(p->constblock.const.cr[0] > 0) return(1);
  1776. !         if(p->constblock.const.cr[0] < 0) return(-1);
  1777. !         return(0);
  1778. ! #endif GFLOAT
  1779.       case TYDREAL:
  1780.           if(p->constblock.const.cd[0] > 0) return(1);
  1781.           if(p->constblock.const.cd[0] < 0) return(-1);
  1782. ***************
  1783. *** 2553,2559
  1784.           if(p->constblock.const.cd[0] < 0) return(-1);
  1785.           return(0);
  1786.   
  1787. !     case TYCOMPLEX:
  1788.       case TYDCOMPLEX:
  1789.           return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  1790.   
  1791.  
  1792. --- 2679,2687 -----
  1793.           if(p->constblock.const.cd[0] < 0) return(-1);
  1794.           return(0);
  1795.   
  1796. !     case TYCOMPLEX: 
  1797. ! #ifdef GFLOAT
  1798. !     return(p->constblock.const.cr[0]!=0 || p->constblock.const.cr[1]!=0);
  1799.       case TYDCOMPLEX:
  1800.       return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  1801.   #else GFLOAT
  1802. ***************
  1803. *** 2555,2561
  1804.   
  1805.       case TYCOMPLEX:
  1806.       case TYDCOMPLEX:
  1807. !         return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  1808.   
  1809.       default:
  1810.           badtype( "conssgn", p->constblock.vtype);
  1811.  
  1812. --- 2683,2693 -----
  1813.   #ifdef GFLOAT
  1814.       return(p->constblock.const.cr[0]!=0 || p->constblock.const.cr[1]!=0);
  1815.       case TYDCOMPLEX:
  1816. !     return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  1817. ! #else GFLOAT
  1818. !     case TYDCOMPLEX:
  1819. !     return(p->constblock.const.cd[0]!=0 || p->constblock.const.cd[1]!=0);
  1820. ! #endif GFLOAT
  1821.   
  1822.       default:
  1823.           badtype( "conssgn", p->constblock.vtype);
  1824. SHAR_EOF
  1825. chmod +x 'expr.c.diff'
  1826. if test -f 'defs.h.diff'
  1827. then
  1828.     echo shar: over-writing existing file "'defs.h.diff'"
  1829. fi
  1830. cat << \SHAR_EOF > 'defs.h.diff'
  1831. *** ../f77/src/f77pass1/defs.h.orig    Tue Oct 29 15:15:49 1985
  1832. --- ../f77/src/f77pass1/defs.h    Tue Oct 29 15:22:31 1985
  1833. ***************
  1834. *** 367,372
  1835.       char *ccp;
  1836.       ftnint ci;
  1837.       double cd[2];
  1838.       };
  1839.   
  1840.   struct Constblock
  1841.  
  1842. --- 367,375 -----
  1843.       char *ccp;
  1844.       ftnint ci;
  1845.       double cd[2];
  1846. + #ifdef GFLOAT
  1847. +         float cr[4];
  1848. + #endif GFLOAT
  1849.       };
  1850.   
  1851.   struct Constblock
  1852. SHAR_EOF
  1853. chmod +x 'defs.h.diff'
  1854. chdir ..
  1855. chdir ..
  1856. chdir ..
  1857. chdir ..
  1858. #    End of shell archive
  1859. exit 0
  1860.  
  1861.